home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / NEWINT~1 / PROGRE~1 / PROGBA~1.BAS < prev    next >
BASIC Source File  |  1997-06-04  |  2KB  |  57 lines
  1. Attribute VB_Name = "SubClass"
  2. Option Private Module
  3. Option Explicit
  4. Public NextProcs As Long
  5. Public Nodef As Boolean
  6.  
  7. Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
  8. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Any) As Long
  9. Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  10.  (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  11. Public Const WM_USER = &H400
  12. Public Const SB_GETRECT = (WM_USER + 10)
  13. Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal wndrpcPrev As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  14. Public Const WM_DRAWITEM = &H2B
  15. Public Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  16.  Private Const WM_PAINT = &HF
  17.  
  18. Public Const GWL_USERDATA = (-21)
  19. Public Const GWL_WNDPROC = -4
  20.  
  21.  
  22.  
  23. Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, _
  24. ByVal wParam As Long, ByVal lParam As Long) As Long
  25. On Error Resume Next
  26.   
  27.  Select Case hwnd
  28.  
  29.         
  30.         Case frmProgressBar.hwnd
  31.              frmProgressBar.ProcMsg hwnd, uMsg, wParam, lParam, 0& ', 0&
  32.       
  33.     End Select
  34.     If Nodef = True Then
  35.     WindowProc = CallWindowProc(NextProcs, hwnd, uMsg, wParam, ByVal lParam)
  36.     Else
  37.     Nodef = False
  38.     Nodef = True
  39.     End If
  40. End Function
  41.  
  42.    
  43.  
  44.  
  45.  Public Sub SubClass(hwnd As Long)
  46. 'NextProcs = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
  47. End Sub
  48. Public Sub UnSubClass()
  49. 'Dim hWndCur As Long
  50. '    hWndCur = Form1.hwnd
  51. '    If NextProcs Then
  52. '        SetWindowLong hWndCur, GWL_WNDPROC, NextProcs
  53. '        NextProcs = 0
  54. '    End If
  55. End Sub
  56.  
  57.